home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 October / macformat-005.iso / Shareware City / Developers / xlispmac / lisp / GLOS.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1994-05-28  |  4.7 KB  |  145 lines  |  [TEXT/xlsp]
  1. ; This is an XLISP-PLUS glossary lookup package.
  2. ; It requires the package facility to work, and uses a file called
  3. ; glos.txt which is the glossary portion of the XLISP documentation file
  4. ; When loaded for the first time, it adds a *glossary* property to all
  5. ; functions which are defined in glos.txt and are in the XLISP package.
  6. ; This property is the displacement into the file. When a glossary lookup
  7. ; occurs the file itself is referenced. By operating this way, very little
  8. ; space is taken for this feature.
  9.  
  10. ; There are two user-accessable symbols. tools:*glospaging* is a variable
  11. ; which causes the output to "page" (pause for user response) at every
  12. ; screenful. Set it to NIL to defeat this feature or to the number of lines
  13. ; per page to enable.
  14.  
  15. ; The main entry point is the function tools:glos. When given an argument that
  16. ; is a function symbol, it will look up the glossary definition. If the
  17. ; symbol is not in the XLISP package, or if a second non-nil argument is
  18. ; supplied, the name will be passed to APROPOS, and the glossary definitions
  19. ; for all matching symbols will be displayed
  20.  
  21. ; For instance (glos :car) or (glos 'car) or (glos "car") will show the
  22. ; definition for the CAR function, while (glos 'car t) will show that of
  23. ; MAPCAR as well. (glos "X") will give the glossary listing of all functions
  24. ; with names containing an X character, since there is no external symbol
  25. ; named X in the XLISP package.
  26.  
  27. ; It would not be that difficult to modifify this program for environments
  28. ; where packages are not compiled in, however operation would not be quite
  29. ; as sophisticated.
  30.  
  31. ;Tom Almy
  32. ;10/93
  33.  
  34. ; Revised 2/94, improving operation and clarifying some loading messages
  35.  
  36. #-:packages
  37. (error "This utility was written asuming the package facility is in use")
  38. #-:common
  39. (load "common")
  40.  
  41. (unless (find-package "TOOLS")
  42.     (make-package "TOOLS" :use '("XLISP")))
  43.  
  44. (in-package "TOOLS")
  45.  
  46. (export '(glos *glospaging*))
  47.  
  48. (defvar *glosfilename*)
  49.  
  50. ; We will look things up while loading
  51. ; so we can toss all the code when done
  52.  
  53. (unless *glosfilename*
  54.     (format t "~&Building glossary references---")
  55.     (let ((lpar #\()
  56.           (rpar #\))
  57.           (dot #\.)
  58.           (*pos* 0)
  59.           symbol)
  60.          (labels (
  61.           
  62.  
  63. (xposition (chr str &aux (pos (position chr str)))
  64.        (if pos pos (length str)))
  65.  
  66. (seek-next-fcn (strm)
  67.        (do ((thispos *pos* (file-position strm))
  68.         (text (read-line strm nil) (read-line strm nil)))
  69.        ((null text) nil)
  70.        (when (and (> (length text) 3)
  71.               (or (char= lpar (char text 0))
  72.               (char= dot (char text 0))))
  73.          (setf *pos* thispos)
  74.          (return-from seek-next-fcn
  75.                   (subseq text 1 (min (xposition rpar text)
  76.                           (xposition #\space text))))))))
  77.  
  78. ;; The body of the code that does the work:           
  79.            (unless (open "glos.txt" :direction :probe)
  80.                (error "Could not find glossary file glos.txt"))
  81.            (with-open-file
  82.             (strm "glos.txt")
  83.             (setq *glosfilename* (truename strm))
  84.             (do ((name (seek-next-fcn strm) (seek-next-fcn strm)))
  85.             ((null name) nil)
  86.             (setq symbol (find-symbol (string-upcase name) :xlisp))
  87.             (unless symbol (format t "~&Documented symbol ~s not found in XLISP.~%" name))
  88.             (when symbol
  89. ;                  (format t "~s " symbol)
  90.                   (setf (get symbol '*glossary*) *pos*))))
  91. ;; Check for functions & vars in package XLISP that aren't documented
  92.            (format t "~&Not documented, but found in XLISP:")
  93.            (do-external-symbols
  94.             (x :xlisp)
  95.             (when (and (or (fboundp x) (specialp x))
  96.                    (not (get x '*glossary*)))
  97.               (format t "~s " x)))
  98.            (format t "~&")
  99.  
  100. ))) ;; Ends the Flet, let, and unless
  101.  
  102. (defvar *linecount*)
  103. (defvar *glospaging* 23)
  104.  
  105. (defun linechk ()
  106.        (when (and *glospaging*
  107.           (> (incf *linecount*) *glospaging*))
  108.          (setq *linecount* 0)
  109.          (unless (y-or-n-p "--PAUSED--  Continue?")
  110.              (throw 'getoutahere))))
  111.        
  112. (defun glos2 (val)
  113.        (with-open-file
  114.     (strm *glosfilename*)
  115.     (file-position strm val)
  116.     (do ((line (read-line strm nil) (read-line strm nil)))
  117.         ((zerop (length line))
  118.          (linechk)
  119.          (format t "~%"))
  120.         (linechk)
  121.         (format t "~a~%" line))))
  122.  
  123.  
  124. (defun glos (symbol &optional matchall &aux val (sym (string symbol)))
  125.        (catch
  126.     'getoutahere
  127.     (setq *linecount* 0)
  128.     (if (and (null matchall) (setq val (find-symbol sym)))
  129.         (if (setq val (get val '*glossary*))
  130.         (glos2 val)
  131.         (format t"No information on ~a~%" sym))
  132.         (progn
  133.          (setq val
  134.            (do ((list (apropos-list sym :xlisp) (cdr list))
  135.             (result nil result))
  136.                ((null list) result)
  137.                (when (setq val (get (car list) '*glossary*))
  138.                  (pushnew val result))))
  139.          (if (zerop (length val))
  140.          (format t "No matches for ~a~%" symbol)
  141.          (map nil #'glos2 val)))))
  142. #+:mulvals (values)
  143. #-:mulvals nil
  144. )
  145.